home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1985 November / 1985-11.d64 / power poker (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  6KB  |  165 lines
  1. 100 print"[147]"chr$(8):tv=1:x=53280:rem ** set tv to 1 for color tv
  2. 110 iftv=1thenpokex,5:pokex+1,5:pokex+2,13:pokex+3,1:pokex+4,5:goto130
  3. 120 pokex,12:pokex+1,12:pokex+2,15:pokex+3,1:pokex+4,12
  4. 130 dimh1(35),h2(35),sm(30),e(29),ck(25,25),j1(25),j2(25),ca(14)
  5. 140 a$="":b$="":hs=0
  6. 150 gosub470:print"[147]"
  7. 160 printchr$(144)spc(8)"poker hand point values"
  8. 170 printspc(11)"royal flush...400":printspc(11)"str flush.....300"
  9. 180 printspc(11)"4 of a kind...160":printspc(11)"straight......120"
  10. 190 printspc(11)"full house....100":printspc(11)"3 of a kind....60"
  11. 200 printspc(11)"flush..........50":printspc(11)"two pair.......30"
  12. 210 printspc(11)"one pair.......10"
  13. 220 printchr$(19)chr$(5)a$spc(13)"loading  data"
  14. 230 fori=1to573:reada:t=t+a:next
  15. 240 ift<>113126thenprint"error in data statements.":stop
  16. 250 restore:poke56334,peek(56334)and254:poke1,peek(1)and251
  17. 260 fori=0to511:pokei+14336,peek(i+53248):next
  18. 270 poke1,peek(1)or4:poke56334,peek(56334)or1
  19. 280 forx=14336to14343:reada:pokex,a:next
  20. 290 forx=14552to14591:reada:pokex,a:next
  21. 300 forx=14640to14703:reada:pokex,a:next
  22. 310 forx=14808to14839:reada:pokex,a:next
  23. 320 forx=1to4:readsu(x):readco(x):next
  24. 330 forx=2to14:readca(x):next
  25. 340 forx=5to30:readsm(x):msb=int(sm(x)/256):lsb=sm(x)-(msb*256)
  26. 350 poke823+x,lsb:poke850+x,msb:next
  27. 360 forx=49152to49533:readml:pokex,ml:next
  28. 370 poke53272,(peek(53272)and240)or14
  29. 380 poke53265,peek(53265)or64:goto500
  30. 390 d$=str$(hs):printchr$(19)a$b$spc(9)"h s"
  31. 400 iflen(d$)=2thenprintb$spc(10)d$"[157][157][157]00"chr$(5):return
  32. 410 iflen(d$)=3thenprintb$spc(9)d$"[157][157][157]0"chr$(5):return
  33. 420 printb$spc(8)hschr$(5):return
  34. 430 d$=str$(sc):printchr$(19)a$b$"score"
  35. 440 iflen(d$)=2thenprintb$spc(2)d$"[157][157][157]00":return
  36. 450 iflen(d$)=3thenprintb$spc(1)d$"[157][157][157]0":return
  37. 460 printb$sc:return
  38. 470 poke53272,(peek(53272)and15)or240:poke648,60:return
  39. 480 geti$:ifi$=""then480
  40. 490 poke53272,(peek(53272)and15)or16:poke648,4:return
  41. 500 printchr$(19)chr$(5)a$spc(13)"  shuffling  ":forx=1to25
  42. 510 j1(x)=int(rnd(.)*13)+2:j2(x)=int(rnd(0)*4)+1:ifck(j1(x),j2(x))=1then510
  43. 520 ck(j1(x),j2(x))=1:e(x+4)=0:next
  44. 530 sc=0:nh=0:printchr$(19)a$spc(13)"            ":gosub490
  45. 540 printchr$(147):sys49194:printchr$(144):gosub390:gosub430
  46. 550 printb$chr$(144)"press f1 for":printb$"[145]point values"
  47. 560 forn=1to25:poke781,30:sys49166
  48. 570 poke251,ca(j1(n)):poke252,su(j2(n)):poke10,co(j2(n)):poke781,30:sys49297
  49. 580 poke198,0
  50. 590 geti$:ifi$=""then590
  51. 600 ifi$="[133]"thensys49449:gosub470:gosub480:sys49502:goto580
  52. 610 h=asc(i$)-60:ifh<5orh>29then580
  53. 620 ife(h)=1then580
  54. 630 e(h)=1:h1(h)=j1(n):poke781,30:sys49180
  55. 640 poke781,h:sys49166:poke883+h,co(j2(n))
  56. 650 poke251,ca(j1(n)):poke252,su(j2(n)):poke10,co(j2(n)):poke781,h:sys49297
  57. 660 row=int(h/5)*5:a=row:b=a+4:bx=0:forx=atob:ife(x)=1thenbx=bx+1
  58. 670 next:ifbx=5thengosub790
  59. 680 a=(h-row)+5:b=a+20:by=0:forx=atobstep5:ife(x)=1thenby=by+1
  60. 690 next:ifby=5thengosub900
  61. 700 ck(j1(n),j2(n))=0:nextn:ifsc>hsthenhs=sc:nh=1
  62. 710 printchr$(19)b$" play again":fort=1to300:next
  63. 720 ifnh=1thenpoke646,peek(53281):gosub390
  64. 730 printchr$(19)b$"   y or n   ":fort=1to300:next
  65. 740 ifnh=1thenprintchr$(144):gosub390
  66. 750 geti$:ifi$="y"thenprintchr$(147):sys49449:gosub470:goto500
  67. 760 ifi$="n"then780
  68. 770 goto710
  69. 780 poke53265,27:poke53272,21:printchr$(147)chr$(144):end
  70. 790 l=0:r=0:k=0:cs=0:p=1
  71. 800 forx=atob:h2(x)=h1(x):cs=cs+h1(x):l=l+peek(sm(x)+82):next
  72. 810 h2(b+1)=0:forx=atob:forxx=atob
  73. 820 ifh2(xx)<h2(x)thenc=h2(x):h2(x)=h2(xx):h2(xx)=c
  74. 830 next:next:forx=atob:poke882+p,0:forxx=atob
  75. 840 ifh1(xx)=h1(x)thenk=k+1:ifxx<>xthenpoke882+p,x
  76. 850 next:p=p+1:next:h2(a-1)=0:forx=atob:ifh2(x-1)=1+h2(x)thenr=r+1
  77. 860 next:ifr=4thengosub890
  78. 870 ifl/5=peek(sm(b)+82)thengosub890:goto1080
  79. 880 goto1000
  80. 890 ss=1-(b-a=20)*4:p=1:forx=atobstepss:poke882+p,x:p=p+1:next:return
  81. 900 l=0:r=0:k=0:cs=0:p=1
  82. 910 forx=atobstep5:h2(x)=h1(x):cs=cs+h1(x):l=l+peek(sm(x)+82):next
  83. 920 h2(b+5)=0:forx=atobstep5:forxx=atobstep5
  84. 930 ifh2(xx)<h2(x)thenc=h2(x):h2(x)=h2(xx):h2(xx)=c
  85. 940 next:next:forx=atobstep5:poke882+p,0:forxx=atobstep5
  86. 950 ifh1(xx)=h1(x)thenk=k+1:ifxx<>xthenpoke882+p,x
  87. 960 next:p=p+1:next:h2(a-5)=0:forx=atobstep5:ifh2(x-5)=1+h2(x)thenr=r+1
  88. 970 next:ifr=4thengosub890
  89. 980 ifl/5=peek(sm(b)+82)thengosub890:goto1080
  90. 990 goto1000
  91. 1000 ifr=4thensc=sc+120:c$="  straight":goto1130
  92. 1010 ifk=7thensc=sc+10:c$="  one pair":goto1130
  93. 1020 ifk=9thensc=sc+30:c$="  two pair":goto1130
  94. 1030 ifk=11thensc=sc+60:c$=" 3 of a kind":goto1130
  95. 1040 ifk=13thensc=sc+100:c$="  full house":goto1130
  96. 1050 ifk=17thensc=sc+160:c$=" 4 of a kind":goto1130
  97. 1060 ifh2(a)=14andr=3andcs=28thensc=sc+120:c$="  straight":gosub890:goto1130
  98. 1070 return
  99. 1080 ifr=4then1110
  100. 1090 ifh2(a)=14andcs=28thensc=sc+300:c$="  str flush":goto1130
  101. 1100 sc=sc+50:c$="   flush":goto1130
  102. 1110 ifh2(a)=14thensc=sc+400:c$=" royal flush":goto1130
  103. 1120 sc=sc+300:c$="  str flush"
  104. 1130 forx=1to8:printchr$(19)chr$(144)""b$c$:sys49396:fort=1to75:next
  105. 1140 printchr$(19)chr$(5)""b$c$:sys49422:fort=1to75:next:next
  106. 1150 printchr$(19)b$"            ":gosub430:return
  107. 1160 data255,255,255,255,255,255,255,0,1,3
  108. 1170 data7,15,31,63,127,255,128,192,224,240
  109. 1180 data248,252,254,255,127,63,31,15,7,3
  110. 1190 data1,0,254,252,248,240,224,192,128,0
  111. 1200 data0,0,0,0,0,0,0,0,0,28
  112. 1210 data62,127,255,255,255,127,0,56,124,254
  113. 1220 data255,255,255,254,63,31,15,7,3,1
  114. 1230 data0,0,252,248,240,224,192,128,0,0
  115. 1240 data0,3,15,31,31,15,3,57,0,192
  116. 1250 data240,248,248,240,192,156,127,255,255,127
  117. 1260 data57,1,3,0,254,255,255,254,156,128
  118. 1270 data192,0,0,1,3,7,15,31,63,127,0
  119. 1280 data128,192,224,240,248,252,254,255,255,255,127
  120. 1290 data57,1,3,0,255,255,255,254,156,128,192,0
  121. 1300 data155,2,166,2,170,0,187,0,178,179,180
  122. 1310 data181,182,183,184,185,177,138,145,139,129
  123. 1320 data1024,1029,1034,1039,1044,1224,1229,1234
  124. 1330 data1239,1244,1424,1429,1434,1439,1444,1624,1629
  125. 1340 data1634,1639,1644,1824,1829,1834,1839,1844,1254
  126. 1350 data169,95,133,251,169,64,133,252,32,72
  127. 1360 data192,76,99,192,169,159,133,251,169,128
  128. 1370 data133,252,32,72,192,76,99,192,169,223
  129. 1380 data133,251,169,192,133,252,32,72,192,76
  130. 1390 data99,192,169,0,133,10,162,30,202,134
  131. 1400 data79,32,0,192,32,79,192,160,41,138
  132. 1410 data105,60,145,253,32,225,192,224,5,208
  133. 1420 data233,96,169,0,133,2,76,83,192,169
  134. 1430 data41,133,2,24,189,55,3,101,2,133
  135. 1440 data253,189,82,3,105,0,133,254,96,160
  136. 1450 data4,165,252,145,253,136,208,251,32,131
  137. 1460 data192,162,4,160,4,165,251,145,253,136
  138. 1470 data208,251,32,131,192,202,208,241,166,79
  139. 1480 data96,24,165,253,105,40,133,253,165,254
  140. 1490 data105,0,133,254,96,32,79,192,160,0
  141. 1500 data165,251,145,253,201,177,240,43,169,164
  142. 1510 data133,2,32,83,192,165,251,145,253,169
  143. 1520 data82,133,2,32,83,192,160,0,165,252
  144. 1530 data145,253,105,1,200,145,253,105,1,160
  145. 1540 data40,145,253,105,1,200,145,253,76,225
  146. 1550 data192,200,169,176,145,253,169,162,133,2
  147. 1560 data32,83,192,165,251,145,253,169,176,200
  148. 1570 data145,253,76,169,192,134,79,32,72,192
  149. 1580 data24,165,254,105,212,133,254,165,10,133
  150. 1590 data251,76,108,192,160,5,190,114,3,224
  151. 1600 data0,240,11,132,78,169,1,133,10,32
  152. 1610 data227,192,164,78,136,192,0,208,233,96
  153. 1620 data160,5,190,114,3,224,0,240,12,132
  154. 1630 data78,189,115,3,133,10,32,227,192,164
  155. 1640 data78,136,192,0,208,232,96,160,249,185
  156. 1650 data0,216,153,0,128,185,250,216,153,250
  157. 1660 data128,185,244,217,153,244,129,185,238,218
  158. 1670 data153,238,130,136,192,255,208,227,160,249
  159. 1680 data169,0,153,0,216,153,250,216,153,244
  160. 1690 data217,153,238,218,136,192,255,208
  161. 1700 data239,96,160,249,185,0,128,153,0,216
  162. 1710 data185,250,128,153,250,216,185,244,129,153
  163. 1720 data244,217,185,238,130,153,238,218,136,192
  164. 1730 data255,208,227,96
  165.